| VBA小工具：EXCEL如何批量给每行下面插入n个空行？ | 您所在的位置：网站首页 › Excel vba 运行特定行 › VBA小工具：EXCEL如何批量给每行下面插入n个空行？ |
VBA小工具：EXCEL如何批量给每行下面插入n个空行？
|
目录 1EXCEL本身的方法 2 VBA实现1： 2.1 粗糙代码 2.2 需要注意的问题 3 VBA实现2： 3.1 改进代码：根据用户自己先选中的区域，进行插入空行操作。 3.1.1 用户可在EXCEL里选中区域，而不是改VBA代码 3.1.2 自动识别用户选择区域的行数范围 4 神奇的部分：用文心一言问了下给了我一个代码，是有问题的，但是可以拿来参考 4.1 文心一言给我的代码 1EXCEL本身的方法 给每行加1个序号，也就是新增一个辅助列：序号列，比如1，2，3，然后把要插入空行的区域，再其接着的下面行复制粘贴n份，你要插入多少个空行，就再复制n-1份然后对辅助列：序号列排序按照 升序排列即可数据是否包含标题，自己酌情看，最多只有原始数据上有表头/或没表头，不能有多份表头
2 VBA实现1： 2.1 粗糙代码 需要手动写死 行数范围的上限和下限 2.2 需要注意的问题 （1） 写循环时，需要注意一定要从下面往上面插入，否则区域往下循环时会被插入列打乱（2） Cells(i + 1, 2).Insert 会导致不会整行下移，而只是这个单元格下移，根据需要改写ThisWorkbook.ActiveSheet.Cells(i + 1, 2).Insert shift:=xlDown ' 单元格下移ThisWorkbook.ActiveSheet.Rows(i + 1).Insert Shift:=xlDown ' 整行下移（3） 内外层循环内层循环，根据调用函数的参数得知要循环插入的行数 times外层循环，本身的行数，也就是要执行的次数（4） 从下面开始插入新行，那么最后1行如果下面没内容，就可以从 maxr1 - 1 行开始插入即可插入行的时候要注意，EXCEL插入insert操作是再当前行的上面插入一行，所以实际执行时，需要使用 i+1 而不是 i . Sub testcopy2() Call testcopy1(3) End Sub Function testcopy1(times) ' 写死要插入行的范围 minr1 = 1 maxr1 = 7 '一定要从下面往上面插入，否则区域往下循环时会被插入列打乱 For i = maxr1 - 1 To minr1 Step -1 For j = 1 To times ' Cells(i + 1, 2).Insert 会导致不会整行下移，而只是这个单元格下移，根据需要改写 ' ThisWorkbook.ActiveSheet.Cells(i + 1, 2).Insert shift:=xlDown ThisWorkbook.ActiveSheet.Rows(i + 1).Insert Shift:=xlDown Next j Next i End Function 3 VBA实现2： 3.1 改进代码：根据用户自己先选中的区域，进行插入空行操作。 3.1.1 用户可在EXCEL里选中区域，而不是改VBA代码 需要，用户先选中一个指定区域，比如 下图这样让用户在EXCEL操作选中，比VBA里改参数还是友好的多
3.1.2 自动识别用户选择区域的行数范围 首先，无论是selection 还是 range 其 address属性，就包含了行列信息，有的应该还可以拆解为RIC1格式'需要处理Address "$B$1:$C$6" 取出 row的范围，minr-maxr'再从 "$B$1" 取到行数row '需要处理Address "$B$1:$C$6" 取出 row的范围，minr-maxr SA2 = Split(Selection.Address, ":") For i = LBound(SA2) To UBound(SA2) minr1 = SA2(0) maxr1 = SA2(1) Next '再从 "$B$1" 取到行数row minr1 = Right(SA2(0), Len(SA2(0)) - Application.Find("$", SA2(0), 2)) maxr1 = Right(SA2(1), Len(SA2(1)) - Application.Find("$", SA2(1), 2)) Sub testcopy2() Call testcopy1(5) End Sub Function testcopy1(times) '需要用户先在EXCEL手动选择一个区域Selection '需要处理Address "$B$1:$C$6" 取出 row的范围，minr-maxr SA2 = Split(Selection.Address, ":") For i = LBound(SA2) To UBound(SA2) minr1 = SA2(0) maxr1 = SA2(1) Next minr1 = Right(SA2(0), Len(SA2(0)) - Application.Find("$", SA2(0), 2)) maxr1 = Right(SA2(1), Len(SA2(1)) - Application.Find("$", SA2(1), 2)) For i = maxr1 - 1 To minr1 Step -1 For j = 1 To times - 1 ThisWorkbook.ActiveSheet.Rows(i + 1).Insert Shift:=xlDown Next j Next i End Function 4 神奇的部分：用文心一言问了下给了我一个代码，是有问题的，但是可以拿来参考 4.1 文心一言给我的代码 执行效果是错的问题1： 插入行没有倒着处理，所以代码执行会有问题问题2： 内外层循环写的有问题
Sub InsertBlankRows1() Dim selectedRange As Range Dim numRows As Integer Dim i As Integer '获取选中区域 Set selectedRange = Selection '获取要插入的空行数 numRows = 3 '这里的数字3表示要插入3个空行 '循环插入空行 For i = 1 To numRows '在每行的下面插入一个空行 For j = 1 To selectedRange.Rows.Count selectedRange.Rows(j).Offset(1).EntireRow.Insert Shift:=xlDown Next j Next i End Sub
|
【本文地址】
公司简介
联系我们